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-- file PSDebug.mesa 

-- last modified by Sweet, June 30, 1978 5:28 PM 

DIRECTORY 

CodeDefs: FROM "codedefs" USING [CCIndex, CCNull , ChunkBase, JumpCCIndex, JumpCCNull , JumpType], 

ErrorTabDefs: FROM "errortabdefs" USING [CompStrDesc], 

lODefs: FROM "iodefs" USING [CR, NumberFormat , WriteChar. WriteDecimal , WriteNumber, WriteOctal, Writ 
**eStr i nal 

P5ADefs:'FR0M "pSadefs" USING [ParamCount], 

PSBDefs: FROM "pSbdefs" USING [AreThreadsVal id], 

SegmentDefs: FROM "segmentdef s" USING [Defaul tPages , Def aultVersion, FileSegmentAddress, FileSegmentH 
♦♦andle, NewFile, NewFileSegment, Read, Swapin, SwapOut, Unlock], 

StringDefs: FROM "stringdefs" USING [Substring, SubStringDescriptor], 

TableDefs: FROM "tabledefs" USING [AddNotify, DropNotify, TableNotif ier], 

TreeDefs: FROM "treedefs" USING [treetype]; 

DEFINITIONS FROM CodeDefs; 

P5Debug: PROGRAM 

IMPORTS lODefs, PSADefs, P5BDefs, SegmentDefs, TableDefs ■ 
BEGIN 

cb: ChunkBase; -- code base (local copy) 

P5DebugNotify: TableDefs. TableNotif ier - 

BEGIN -- called by allocator whenever table area is repacked 

cb ^ LOOPHOLE[base[TreeDefs. treetype]]; 

RETURN 

END; 

Substring: TYPE - StringDefs .Substring; 
fopnameSH: SegmentDefs. FileSegmentHandle ♦■ NIL; 
mopnameSH: SegmentDefs. FileSegmentHandle ^ NIL; 
fopbase, mopbase: STRING; 

fopnames: POINTER TO ARRAY [0..256) OF ErrorTabDefs. CompStrDesc; 
mopnames: POINTER TO ARRAY [0..256) OF ErrorTabDefs. CompStrDesc; 

SwapInOpTab: PROCEDURE - 
BEGIN OPEN SegmentDefs; 
fopbase <- mopbase ♦- NIL; 
BEGIN 

IF fopnameSH « NIL THEN fopnameSH ♦- NewFileSegment[ 

NewFile["FOpNames. binary", Read, DefaultVersion lANY ■> GOTO notfound], 
1, Defaul tPages, Read]; 
SwapIn[fopnameSH]; 

fopnames <- FileSegmentAddress[fopnameSH]+l; 

fopbase ^ LOOPHOLE[fopnames + 256*SIZE[ErrorTabDefs. CompStrDesc] , STRING]; 
EXITS notfound ■> NULL; 
END; 
BEGIN 

IF mopnameSH « NIL THEN mopnameSH ♦- NewFileSegment[ 

NewFile["OpNames. binary", Read, DefaultVersion lANY ■> GOTO notfound], 
1, Def aul tPages , Read]; 
SwapIn[mopnameSH] ; 

mopnames ♦- FileSegmentAddress[mopnameSH]+l; 

mopbase ♦- LOOPHOLE[mopnames + 256*SIZE[ErrorTabDefs .CompStrDesc] , STRING]; 
EXITS notfound «> NULL; 
END; 
RETURN 
END; 

CloseOpTable: PROCEDURE - 
BEGIN 
IF fopnameSH # NIL THEN 

BEGIN 

SegmentDefs. Unlock [fopnameSH]; 

SegmentDefs .SwapOut[fopnameSH] ; 

END; 
IF fopnameSH # NIL THEN 

BEGIN 

SegmentDefs. Unlock[mopnameSH] ; 

SegmentDefs .SwapOut[mopnameSH] ; 

END; 
RETURN 
END; 
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WriteSubString: PROCEDURE [ss: Substring] ■ 
BEGIN 

i: CARDINAL; 
FOR 1 IN [ss. offset. .ss.offset+ss. length) 

DO 

IODefs.WriteChar[ss.baseCi]] 

ENDLOOP; 
RETURN 
END; 

PrintChunks: PUBLIC PROCEDURE [v: CodeDef s.CCIndex] ■ 
BEGIN 

OPEN lODefs; 
c: CCIndex; 
jc: JumpCCIndex; 
i: CARDINAL; 
ThreadsValid: BOOLEAN ♦■ P5BDefs.AreThreadsVa1 id[]; 

TableDefs.AddNotify[P5DebugNotify]; 
SwapInOpTab[]; 
WriteChar[CR]; 

FOR c ^ V, cb[c].f1ink UNTIL c ■ CCNull DO 
WriteNumber[c, Number Format [10, FALSE .TRUE. 6]]; 
WITH cc:cb[c] SELECT FROM 
label -> 
BEGIN 

WriteString[": Label "L]; 
IF ThreadsValid THEN 

FOR jc *- cc.jumplist, cb[Jc] . thread UNTIL jc - JumpCCNull DO 
WriteChar[' ]; WriteNumber[jc, NumberFormat[10, FALSE, TRUE, 6]]; 
ENDLOOP; 
END; 
jump ■> 
BEGIN 

WriteString[": "L]; WriteJumpName[cc. jtype] ; WriteChar[' ]; 
WriteDecimal[LOOPHOLE[cc.destlabel]]; 
END; 
code ■> 
BEGIN 

WriteString[": Code "L]; 
IF cc.realinst THEN WriteMOpName[cc. inst] 
ELSE WriteFOpName[cc.inst]; 

FOR i IN [l..P5ADefs.ParamCount[L00PHOLE[c]]] DO 
WriteNumber[cc.parameters[i], [8, FALSE, TRUE, 7]]; 
WriteChar['B]; 
ENDLOOP; 
WriteString[", source "L]; WriteOctal[cc.sourcef ileindex]; 
END; 
other -> WITH cc SELECT FROM 

table «> WriteString[": Table"L]; 
startbody. endbody ■> 
BEGIN 

WriteString[IF cc.otag ■ startbody THEN ": Starf'L ELSE ": End^'L]; 
WriteString["Body, bti: "L]; 
WriteDecimal[LOOPHOLE[ index]]; 
END; 
ENDCASE; 
ENDCASE; 
IF cb[c].pad # THEN WriteString[" pad"l"L]; 
WriteChar[CR]; 
ENDLOOP; 
CloseOpTable[]; 

TableDefs.DropNotify[P5DebugNotify]; 
RETURN 
END; 

WriteFOpName: PROCEDURE [n: CARDINAL] ■ 
BEGIN OPEN lODefs; 

opss: StringDefs.SubStringOescriptor; 
WriteChar[ 'q]; 

IF fopbase ■ NIL THEN WriteNumber[n. [8, TRUE. TRUE.3]] 
ELSE 

BEGIN 

opss. base <- fopbase; 
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opss. offset ^ fopnames[n]. offset; 

opss. length ^ fopnani8s[n]. length; 

IF opss. length - THEN WriteNumber[n,[8,TRUE.TRUE.3]] 

ELSE Wr1teSubString[0ops8]; 

END; 
RETURN 
END; 

WriteMOpName: PROCEDURE [n: CARDINAL] ■ 
BEGIN OPEN lODefs; 

opss: StringDefs.SubStringDescriptor; 
WriteChar['z]; 

IF mopbase ■ NIL THEN WriteNumber[n.C8.TRUE,TRUE.3]] 
ELSE 

BEGIN 

opss. base ^ mopbase; 

opss. offset ^ mopnames[n]. offset; 

opss. length ^ mopnamesfn]. length; 

IF opss. length ■ THEN WriteNuniber[n,[8.TRUE.TRUE.3]] 

ELSE WriteSubString[0opss]; 

END; 
RETURN 
END; 

WriteJumpName: PROCEOURE[n: CodeDefs . JumpType] ■ 
BEGIN OPEN lODefs; 
JumpName: ARRAY CodeDefs. JumpType OF STRING ■ 

["JumpE"L, "JumpN"L, "JumpL"L. "JumpGE"L, "JumpG"L. "JumpLE"L. 
"UJumpL"L, "UJumpGE"L. "UJumpG"L, "UJumpLE"L. "ZJumpE"L. "ZJumpN"L. 
"Jump"L, "JumpA"L, "JumpC'L. "JumpCA"L. "JumpRet"L. 
"NILJumpE"L, "NILOumpN"L. 
"PAIRJumpL"L, "PAIRJumpG"L, "BYTEJumpE"L. "BYTEJumpN"L, "BITJumpE"L. "BITJumpN"L]; 

IF n > LAST[JumpType3 THEN 

BEGIN WriteCharC'j]; WriteDecimal[L00PH0LE[n]3 END 
ELSE WriteString[JumpName[n]3; RETURN 
END; 

END... 



